{-------------------------------------------------------------------------------
BirPlay audio player.
Copyright (C) 2013 Alexey Tatuyko

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>

You can contact with me by e-mail: tatuich@gmail.com


The Original Code is uplayer.pas by Alexey Tatuyko, released 2013-04-11.
All Rights Reserved.

$Id: uplayer.pas, v 1.0.0.28 2013/04/11 23:01:00 tatuich Exp $

You may retrieve the latest version of this file at the BirEdit project page,
located at http://birplay.googlecode.com/

}

unit uplayer;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, bass,
  Vcl.Buttons, Vcl.StdCtrls, uabout, Vcl.ExtCtrls, Vcl.ComCtrls,
  Vcl.Samples.Gauges, JvComponentBase, JvDragDrop;

type
  Twplayer = class(TForm)
    btn1: TSpeedButton;
    btn2: TSpeedButton;
    btn3: TSpeedButton;
    btn4: TSpeedButton;
    tracklist: TListBox;
    btn5: TSpeedButton;
    opendlg: TOpenDialog;
    btn7: TSpeedButton;
    btn8: TSpeedButton;
    tmr1: TTimer;
    volumebar: TTrackBar;
    progbar: TGauge;
    tmr2: TTimer;
    jvdrag: TJvDragDrop;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);
    procedure btn8Click(Sender: TObject);
    procedure volumebarChange(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure tmr2Timer(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure jvdragDrop(Sender: TObject; Pos: TPoint; Value: TStrings);
  private
    playstr: HSTREAM;
    procedure PlayBassError(msg: string);
    procedure PlayBassPlay(f: TFileName);
    procedure PlayBassNext;
    procedure PlayBassPrev;
    procedure PlayBassStop;
    procedure PlayBassAddFiles(f: TStrings);
  end;

var
  wplayer: Twplayer;

implementation

{$R *.dfm}

procedure Twplayer.PlayBassError;
var
  s: string;
begin
  s := msg + #13#10 + '(Error code: ' + IntToStr(BASS_ErrorGetCode) + ')';
  MessageBox(Handle, PChar(s), nil, 0);
end;

procedure Twplayer.PlayBassPlay(f: TFileName);
begin
  tmr2.Enabled := False;
  BASS_StreamFree(playstr);
	playstr := BASS_StreamCreateFile(False, PChar(f), 0, 0, 0 or BASS_UNICODE);
	if playstr = 0 then PlayBassError('Error creating stream!');
  if not BASS_ChannelPlay(playstr, True)
  then PlayBassError('Error playing stream!') else tmr2.Enabled := True;
end;

procedure Twplayer.PlayBassNext;
begin
  tracklist.ItemIndex := tracklist.ItemIndex + 1;
  PlayBassPlay(tracklist.Items.Strings[tracklist.ItemIndex]);
end;

procedure Twplayer.PlayBassPrev;
begin
  tracklist.ItemIndex := tracklist.ItemIndex - 1;
  PlayBassPlay(tracklist.Items.Strings[tracklist.ItemIndex]);
end;

procedure Twplayer.PlayBassStop;
begin
  tmr2.Enabled := False;
  BASS_ChannelStop(playstr);
end;

procedure Twplayer.PlayBassAddFiles(f: TStrings);

  procedure PlayBassCheckFile(p: string);
  var
    tmp: HSTREAM;
  begin
    if (ExtractFileExt(p) = '.mp3') or (ExtractFileExt(p) = '.mp2') or
      (ExtractFileExt(p) = '.mp1') or (ExtractFileExt(p) = '.aif') or
      (ExtractFileExt(p) = '.aiff') or (ExtractFileExt(p) = '.oga') or
      (ExtractFileExt(p) = '.ogg') or (ExtractFileExt(p) = '.wav')
    then begin
      tmp := BASS_StreamCreateFile(False, PChar(p), 0, 0, 0 or BASS_UNICODE);
      try
        if tmp <> 0 then tracklist.Items.Add(p);
      finally
        BASS_StreamFree(tmp);
      end;
    end;
  end;

  procedure PlayBassScanDir(s: string);
  var
    m: TSearchRec;
  begin
    s := IncludeTrailingPathDelimiter(s);
    if FindFirst(s + '*', faAnyFile, m) = 0 then repeat
      if (m.Name = '.') or (m.Name = '..') then Continue;
      if not ((m.Attr and faDirectory) <> 0)
      then PlayBassCheckFile(s + m.Name) else PlayBassScanDir(s + m.Name);
    until FindNext(m) <> 0;
    FindClose(m);
  end;

var
  i: Integer;

begin
  if f.Count > 0 then for I := 0 to f.Count - 1 do if FileExists(f.Strings[i])
    then PlayBassCheckFile(f.Strings[i]) else if DirectoryExists(f.Strings[i])
      then PlayBassScanDir(f.Strings[i]);
end;

procedure Twplayer.btn1Click(Sender: TObject);
begin
  PlayBassPlay(tracklist.Items.Strings[tracklist.ItemIndex]);
end;

procedure Twplayer.btn2Click(Sender: TObject);
begin
  PlayBassStop;
end;

procedure Twplayer.btn3Click(Sender: TObject);
begin
  PlayBassNext;
end;

procedure Twplayer.btn4Click(Sender: TObject);
begin
  PlayBassPrev;
end;

procedure Twplayer.btn5Click(Sender: TObject);
begin
  if opendlg.Execute then PlayBassAddFiles(opendlg.Files);
end;

procedure Twplayer.btn7Click(Sender: TObject);
begin
  tracklist.Items.Delete(tracklist.ItemIndex);
end;

procedure Twplayer.btn8Click(Sender: TObject);
var
  dlg: Twabout;
begin
  dlg := Twabout.Create(Self);
  try
    dlg.ShowModal;
  finally
    FreeAndNil(dlg);
  end;
end;

procedure Twplayer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  BASS_StreamFree(playstr);
	BASS_Free();
end;

procedure Twplayer.FormCreate(Sender: TObject);
begin
	if (HIWORD(BASS_GetVersion) <> BASSVERSION) then begin
		MessageBox(0, 'An incorrect version of BASS.DLL was loaded', nil,
                 MB_ICONERROR);
		Halt;
	end;
	if not BASS_Init(-1, 44100, 0, Handle, nil)
  then PlayBassError('Error initializing audio!');
end;

procedure Twplayer.jvdragDrop(Sender: TObject; Pos: TPoint; Value: TStrings);
begin
  PlayBassAddFiles(Value);
end;

procedure Twplayer.tmr1Timer(Sender: TObject);
var
  a: Single;
begin
  a := 0;
  btn1.Enabled := tracklist.ItemIndex >= 0;
  btn2.Enabled := playstr <> 0;
  btn3.Enabled := tracklist.ItemIndex + 1 < tracklist.Count;
  btn4.Enabled := tracklist.ItemIndex > 0;
  btn7.Enabled := tracklist.ItemIndex >= 0;
  BASS_ChannelGetAttribute(playstr, BASS_ATTRIB_VOL, a);
  volumebar.Hint := 'Volume: ' + IntToStr(Round(a * 100)) + ' %';
end;

procedure Twplayer.tmr2Timer(Sender: TObject);
begin
  progbar.Progress := Round(BASS_StreamGetFilePosition(playstr, BASS_FILEPOS_CURRENT)*100/(BASS_StreamGetFilePosition(playstr, BASS_FILEPOS_END) - BASS_StreamGetFilePosition(playstr, BASS_FILEPOS_START)));
  if BASS_StreamGetFilePosition(playstr, BASS_FILEPOS_CURRENT) = BASS_StreamGetFilePosition(playstr, BASS_FILEPOS_END) then begin
    if (tracklist.ItemIndex + 2) <= tracklist.Count then PlayBassNext else begin
      tmr2.Enabled := False;
      tracklist.ItemIndex := 0;
      PlayBassPlay(tracklist.Items.Strings[tracklist.ItemIndex]);
    end;
  end;
end;

procedure Twplayer.volumebarChange(Sender: TObject);
begin
  BASS_ChannelSetAttribute(playstr, BASS_ATTRIB_VOL, volumebar.Position / 100);
end;

end.
